home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacHack 1994
/
MacHack 1994.toast
/
MacHack™94
/
Talks & Papers
/
Timothy Knox
/
yerk 3.66
/
Float source
/
fpCode
< prev
next >
Wrap
Text File
|
1994-09-14
|
6KB
|
198 lines
\ code words for floating point support
\ 8/13/85 cbd Version 1.0
\ 1/24/86 gdc Moved f0=, f0>, and f0< to fpcode.
\ ( flt1 flt2 -- abs1 abs2) set up stack for comparison, kill floats
\ leaves D0,D1 and a0,a1 undefined.
:CODE (fcmp2) \ ***** subroutine ****
move.l (A7)+,a2
move.l (A7)+,D1 ; get 2 floats in D0,D1
move.l (A7)+,D0
pea 2(A3,D1.l) ; push abs data addresses
pea 2(A3,D0.l)
move.l YERK[(fltDisp2)],d7 ; get subr addr in d7
jsr 0(a3,d7.l) ; go kill floats in D0,D1
jmp (a2)
;CODE
\ =================== Comparison operators ==============
\ Stack frame for all comparisons:
\ ( float1 float2 -- bool )
:CODE f>
move.l YERK[(fcmp2)],d7 ; get subr addr in d7
jsr 0(a3,d7.l) ; go kill floats in D0,D1
MOVE.W #8,-(A7) ; code for FCMPX
call pack4
sgt D0
move.l D0,-(A7)
;CODE
:CODE f<
move.l YERK[(fcmp2)],d7 ; get subr addr in d7
jsr 0(a3,d7.l) ; go kill floats in D0,D1
MOVE.W #8,-(A7) ; code for FCMPX
call pack4
slt D0
move.l D0,-(A7)
;CODE
:CODE f=
move.l YERK[(fcmp2)],d7 ; get subr addr in d7
jsr 0(a3,d7.l) ; go kill floats in D0,D1
MOVE.W #8,-(A7) ; code for FCMPX
call pack4
seq D0
move.l D0,-(A7)
;CODE
:CODE f<>
move.l YERK[(fcmp2)],d7 ; get subr addr in d7
jsr 0(a3,d7.l) ; go kill floats in D0,D1
MOVE.W #8,-(A7) ; code for FCMPX
call pack4
sne D0
move.l D0,-(A7)
;CODE
:CODE f<=
move.l YERK[(fcmp2)],d7 ; get subr addr in d7
jsr 0(a3,d7.l) ; go kill floats in D0,D1
MOVE.W #8,-(A7) ; code for FCMPX
call pack4
sle D0
move.l D0,-(A7)
;CODE
:CODE f>=
move.l YERK[(fcmp2)],d7 ; get subr addr in d7
jsr 0(a3,d7.l) ; go kill floats in D0,D1
MOVE.W #8,-(A7) ; code for FCMPX
call pack4
sge D0
move.l D0,-(A7)
;CODE
\ ================ Arithmetic operators ==============
\ ( flt1 flt2 -- abs2 abs1) set up stack for operator, kill float in d0
:CODE (fp1) \ ***** subroutine ****
move.l (A7)+,a2 ; hold return address
move.l (A7)+,D0 ; get 2 floats in D0,D1
move.l (A7)+,D1 ;
pea 2(A3,D0.l) ; push abs data addresses
pea 2(A3,D1.l) ; example op: f1 - f2 -> f1
move.l YERK[(fltDisp)],d7 ; get subr addr in d7
jsr 0(a3,d7.l) ; go kill float in D0
jmp (a2)
;CODE
\ --------------------------------------
\ ( f1 f2 -- f1+f2) result gets stored in f2's data
:CODE f+
move.l YERK[(fp1)],d7 ; get subr addr in d7
jsr 0(a3,d7.l) ; go kill float in D0
clr.w -(A7) ; code for FADD
call pack4
move.l D1,-(A7) ;
;CODE
:CODE f-
move.l YERK[(fp1)],d7 ; get subr addr in d7
jsr 0(a3,d7.l) ; go kill float in D0
MOVE.W #2,-(A7) ; code for FSUB
call pack4
move.l D1,-(A7) ;
;CODE
:CODE f*
move.l YERK[(fp1)],d7 ; get subr addr in d7
jsr 0(a3,d7.l) ; go kill float in D0
MOVE.W #4,-(A7) ; code for FMULT
call pack4
move.l D1,-(A7) ;
;CODE
:CODE f/
move.l YERK[(fp1)],d7 ; get subr addr in d7
jsr 0(a3,d7.l) ; go kill float in D0
MOVE.W #6,-(A7) ; code for FDIV
call pack4
move.l D1,-(A7) ;
;CODE
\ floating point modulus function
:CODE fMod
move.l YERK[(fp1)],d7 ; get subr addr in d7
jsr 0(a3,d7.l) ; go kill float in D0
MOVE.W #12,-(A7) ; code for FREM
call pack4
move.l D1,-(A7) ;
;CODE
\ ============= unary operations ==============
:CODE fNegate
move.l (A7),D0
pea 2(A3,D0.l)
MOVE.W #13,-(A7)
call pack4
;CODE
:CODE fAbs
move.l (A7),D0
pea 2(A3,D0.l)
MOVE.W #15,-(A7)
call pack4
;CODE
:CODE sqrt
move.l (A7),D0
pea 2(A3,D0.l)
MOVE.W #18,-(A7)
call pack4
;CODE
:CODE round
move.l (A7),D0
pea 2(A3,D0.l)
MOVE.W #20,-(A7)
call pack4
;CODE
:CODE trunc
move.l (A7),D0
pea 2(A3,D0.l)
MOVE.W #22,-(A7)
call pack4
;CODE
:CODE logBin
move.l (A7),D0
pea 2(A3,D0.l)
MOVE.W #26,-(A7)
call pack4
;CODE
\ ========= conversion to/from Yerk longInt
( flt -- int32)
:CODE float>
move.l (A7),D0 ; get source float
move.l YERK[(fltDisp)],d7 ; get subr addr in d7
jsr 0(a3,d7.l) ; go kill floats in D0
move.l (A7),D0 ; get source float
move.l a7,a0 ; save ptr to the cell
pea 2(A3,D0.l)
move.l a0,-(a7) ; push ptr to the cell
MOVE.W #10256,-(A7) ; $2810
call pack4
;CODE
\ ( int32 -- fp )
:CODE >float
move.l a7,-(a7) ; push ptr to the long
move.l YERK[(fltNew)],d7 ; get subr addr in d7
jsr 0(a3,d7.l) ; go get float in D1
pea 2(a3,d1.l) ; push addr of float
MOVE.W #10254,-(A7) ; $280e
call pack4
move.l D1,(A7) ; replace the long cell with float ptr
;CODE